home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BORL_TIP / TI100 / TI407.ASC < prev    next >
Text File  |  1993-10-22  |  27KB  |  925 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  9.   VERSION  :  4.0xx
  10.        OS  :  PC-DOS
  11.      DATE  :  January 28, 1988                        PAGE  :  1/14
  12.  
  13.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  14.  
  15.  
  16.  
  17.  
  18.   This  version  of Michael Quinlan's ASYNC.INC is compatible  with
  19.   IBM  PC  and  Compatibles.  It  gives  interrupt-driven  buffered
  20.   communication capabilities  to Turbo Pascal  programs written for
  21.   the IBM PC. It is heavily dependent on that hardware.
  22.  
  23.   The Async_ITR routine was taken from N. Arley Dealey's Async4
  24.   procedures, to make this set of routines work with version 4.0 of
  25.   Turbo Pascal.
  26.  
  27.   The  following example routines are public domain  programs  that
  28.   have  been uploaded to our Forum on CompuServe.  As a courtesy to
  29.   our  users  that  do not have  immediate  access  to  CompuServe,
  30.   Technical Support distributes these routines free of charge.
  31.  
  32.   However,  because these routines are public domain programs,  not
  33.   developed by Borland International,  we are unable to provide any
  34.   technical support or assistance using these routines. If you need
  35.   assistance   using   these   routines,    or   are   experiencing
  36.   difficulties,  we  recommend  that you log  onto  CompuServe  and
  37.   request  assistance  from the Forum members that developed  these
  38.   routines.
  39.   }
  40.   Unit Async;
  41.   Interface
  42.   Uses DOS;
  43.  
  44.   {--------------------------------------------------------------}
  45.   {                        ASYNC.INC                             }
  46.   {                                                              }
  47.   {  Async Communication Routines                                }
  48.   {  by Michael Quinlan                                          }
  49.   {  with a bug fixed by Scott Herr                              }
  50.   {  with Async_ISR update to 4.0 by N. Arley Dealey substituted }
  51.   {                               by Keith Hawes                 }
  52.   {  made PCjr-compatible by W. M. Miller                        }
  53.   {  Highly dependent on the IBM PC and PC DOS 2.0 or later      }
  54.   {                                                              }
  55.   {  based on the DUMBTERM program by CJ Dunford                 }
  56.   {  in the January 1984                                         }
  57.   {  issue of PC Tech Journal.                                   }
  58.   {                                                              }
  59.   {  Entry points:                                               }
  60.   {--------------------------------------------------------------}
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  75.   VERSION  :  4.0xx
  76.        OS  :  PC-DOS
  77.      DATE  :  January 28, 1988                        PAGE  :  2/14
  78.  
  79.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  80.  
  81.  
  82.  
  83.  
  84.   Procedure Async_Init;
  85.   {--------------------------------------------------------------}
  86.   {      Performs initialization.                                }
  87.   {                                                              }
  88.   {--------------------------------------------------------------}
  89.  
  90.   function Async_Open(ComPort       : Word;
  91.                       BaudRate      : Word;
  92.                       Parity        : Char;
  93.                       WordSize      : Word;
  94.                       StopBits      : Word) : Boolean;
  95.   {--------------------------------------------------------------}
  96.   {   Sets up interrupt vector, initialize the COM port for      }
  97.   {   processing, sets pointers to the buffer.  Returns FALSE    }
  98.   {   if COM port not installed.                                 }
  99.   {--------------------------------------------------------------}
  100.  
  101.   Function Async_Buffer_Check(var C : Char) : Boolean;
  102.   {--------------------------------------------------------------}
  103.   {      If a character is available, returns TRUE and moves the }
  104.   {        character from the buffer to the parameter            }
  105.   {      Otherwise, returns FALSE                                }
  106.   {--------------------------------------------------------------}
  107.  
  108.   Procedure Async_Send(C : Char);
  109.   {--------------------------------------------------------------}
  110.   {      Transmits the character.                                }
  111.   {--------------------------------------------------------------}
  112.  
  113.   Procedure Async_Send_String(S : string);
  114.   {--------------------------------------------------------------}
  115.   {      Calls Async_Send to send each character of S.           }
  116.   {--------------------------------------------------------------}
  117.  
  118.   Procedure Async_Close;
  119.   {--------------------------------------------------------------}
  120.   {    Turns off the COM port interrupts.                        }
  121.   {    ** MUST ** BE CALLED BEFORE EXITING YOUR PROGRAM;         }
  122.   {    otherwise you will see some really strange errors and     }
  123.   {    to re-boot.                                               }
  124.   {--------------------------------------------------------------}
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  141.   VERSION  :  4.0xx
  142.        OS  :  PC-DOS
  143.      DATE  :  January 28, 1988                        PAGE  :  3/14
  144.  
  145.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  146.  
  147.  
  148.  
  149.  
  150.   procedure Async_Change(BaudRate      : Word;
  151.                          Parity        : Char;
  152.                          WordSize      : Word;
  153.                          StopBits      : Word);
  154.   {--------------------------------------------------------------}
  155.   { Changes communication parameters "on the fly".               }
  156.   { You cannot use the BIOS routines because they drop DTR.      }
  157.   {--------------------------------------------------------------}
  158.  
  159.   var
  160.     Async_Buffer_Overflow : Boolean;
  161.                           { True if buffer overflow has happened }
  162.     Async_Buffer_Used     : Word;
  163.     Async_MaxBufferUsed   : Word;
  164.  
  165.   Implementation
  166.                                            { global declarations }
  167.  
  168.   const
  169.     UART_THR = $00;
  170.                  { offset from base of UART Registers for IBM PC }
  171.     UART_RBR = $00;
  172.     UART_IER = $01;
  173.     UART_IIR = $02;
  174.     UART_LCR = $03;
  175.     UART_MCR = $04;
  176.     UART_LSR = $05;
  177.     UART_MSR = $06;
  178.  
  179.     I8088_IMR = $21;
  180.                    { port address of the Interrupt Mask Register }
  181.  
  182.   const
  183.     Async_Buffer_Max     = 4095;
  184.   var
  185.     Async_Interrupt_Save : pointer;
  186.     Async_ExitProc_Save  : pointer;
  187.     Async_Buffer         : Array[0..Async_Buffer_Max] of char;
  188.     Async_Open_Flag      : Boolean;
  189.     Async_Port           : Word; { current Open port number     }
  190.                                  { (1 or 2)                     }
  191.     Async_Base           : Word; { base for current open port   }
  192.     Async_Irq            : Word; { irq for current open port    }
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  207.   VERSION  :  4.0xx
  208.        OS  :  PC-DOS
  209.      DATE  :  January 28, 1988                        PAGE  :  4/14
  210.  
  211.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  212.  
  213.  
  214.  
  215.  
  216.                          { Async_Buffer is empty if Head = Tail }
  217.  
  218.     Async_Buffer_Head    : Word;   { Locn in Async_Buffer to put }
  219.                                     { next char                  }
  220.     Async_Buffer_Tail    : Word;    { Locn in Async_Buffer to get}
  221.                                     { next char                  }
  222.     Async_Buffer_NewTail  : Word;
  223.  
  224.     Async_BIOS_Port_Table : Array[1..2] of Word absolute $40:0;
  225.       { This table is initialized by BIOS equipment determination}
  226.       { code at boot time to contain the base addresses for the  }
  227.       { installed async adapters.  A value of 0 means "not in-   }
  228.       { stalled."                                                }
  229.  
  230.   const
  231.     Async_Num_Bauds = 8;
  232.     Async_Baud_Table : array [1..Async_Num_Bauds] of record
  233.                                            Baud, Bits : Word
  234.                                         end
  235.                      = ((Baud:110;  Bits:$00),
  236.                         (Baud:150;  Bits:$20),
  237.                         (Baud:300;  Bits:$40),
  238.                         (Baud:600;  Bits:$60),
  239.                         (Baud:1200; Bits:$80),
  240.                         (Baud:2400; Bits:$A0),
  241.                         (Baud:4800; Bits:$C0),
  242.                         (Baud:9600; Bits:$E0));
  243.  
  244.   procedure BIOS_RS232_Init(ComPort, ComParm : Word);
  245.  
  246.   { Issue Interrupt $14 to initialize the UART   }
  247.   { Format of ComParm:  (From IBM Tech. Ref.)    }
  248.   {                                              }
  249.   { 7     6     5     4     3     2      1     0 }
  250.   { --Baud Rate--     -Parity   StopBit  Word Len}
  251.   {  000 =  110       x0 = None   0 = 1  10 = 7  }
  252.   {  001 =  150       01 = Odd    1 = 2  11 = 8  }
  253.   {  010 =  300       11 = Even                  }
  254.   {  011 =  600                                  }
  255.   {  100 = 1200                                  }
  256.   {  101 = 2400                                  }
  257.   {  110 = 4800                                  }
  258.   {  111 = 9600                                  }
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  273.   VERSION  :  4.0xx
  274.        OS  :  PC-DOS
  275.      DATE  :  January 28, 1988                        PAGE  :  5/14
  276.  
  277.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  278.  
  279.  
  280.  
  281.  
  282.   {                                              }
  283.  
  284.   var
  285.     Regs : registers;
  286.   begin
  287.     with Regs do
  288.       begin
  289.         ax := ComParm and $00FF;  { AH=0; AL=ComParm }
  290.         dx := ComPort;
  291.         Intr($14, Regs)
  292.       end;
  293.   end; { BIOS_RS232_Init }
  294.  
  295.   {--------------------------------------------------------------}
  296.   {         ISR - Interrupt Service Routine                      }
  297.   {--------------------------------------------------------------}
  298.  
  299.   PROCEDURE Async_ISR ; INTERRUPT ;
  300.   { Interrupt Service Routine }
  301.   { Invoked when the USART has received a byte of data from the  }
  302.   { comm line re-written 9/10/84 in machine language ; original  }
  303.   { source left as comments re-written 1987 to work under Turbo  }
  304.   { Pascal Version 4.0                                           }
  305.  
  306.   BEGIN { ISR }
  307.     inline($FB/                                { STI }
  308.  
  309.       { get the incoming character }
  310.       { Async_Buffer[Async_Buffer_Head] :=
  311.                       CHR( port[Async_Base + UART_RBR] ) ;       }
  312.       $8B/$16/Async_Base/                    { MOV DX,Base       }
  313.       $EC/                                   { IN AL,DX          }
  314.       $8B/$1E/Async_Buffer_Head/             { MOV BX,BufferHead }
  315.       $88/$87/Async_Buffer/                  { MOV Buffer[BX],AL }
  316.  
  317.       { Async_Buffer_NewHead := SUCC( Async_Buffer_Head ) ;      }
  318.       $43/                                   { INC BX            }
  319.  
  320.       { IF Async_Buffer_NewHead > Async_Buffer_Max
  321.                                 THEN Async_Buffer_NewHead := 0 ; }
  322.       $81/$FB/Async_Buffer_Max/              { CMP BX,BufferMax  }
  323.       $7E/$02/                               { JLE L001          }
  324.       $33/$DB/                               { XOR BX,BX         }
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  339.   VERSION  :  4.0xx
  340.        OS  :  PC-DOS
  341.      DATE  :  January 28, 1988                        PAGE  :  6/14
  342.  
  343.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  344.  
  345.  
  346.  
  347.  
  348.       { IF Async_Buffer_NewHead = Async_Buffer_Tail THEN Overflow}
  349.       { := TRUE                                                  }
  350.       {L001:}
  351.       $3B/$1E/Async_Buffer_Tail/      { CMP BX,Async_Buffer_Tail }
  352.       $75/$08/                               { JNE L002          }
  353.       $C6/$06/Async_Buffer_Overflow/$01/     { MOV Overflow,1    }
  354.       $90/                                   { NOP generated by  }
  355.                                              { assembler         }
  356.       $EB/$16/                               { JMP SHORT L003    }
  357.       { ELSE BEGIN                                               }
  358.       { Async_Buffer_Head := Async_Buffer_NewHead ;              }
  359.       { Async_Buffer_Used  := SUCC( Async_Buffer_Used ) ;        }
  360.       { IF Async_Buffer_Used > Async_MaxBufferUsed THEN          }
  361.       {  Async_MaxBufferUsed := Async_BufferUsed                 }
  362.       {   END ;                                                  }
  363.       {L002:}
  364.       $89/$1E/Async_Buffer_Head/             { MOV BufferHead,BX }
  365.       $FF/$06/Async_Buffer_Used/          { INC Async_BufferUsed }
  366.       $8B/$1E/Async_Buffer_Used/       { MOV BX,Async_BufferUsed }
  367.       $3B/$1E/Async_MaxBufferUsed/  { CMP BX,Async_MaxBufferUsed }
  368.       $7E/$04/                               { JLE L003          }
  369.       $89/$1E/Async_MaxBufferUsed/  { MOV Async_MaxBufferUsed,BX }
  370.       {L003:}
  371.  
  372.       $FA/                                   { CLI               }
  373.  
  374.                                         { issue non-specific EOI }
  375.       { port[$20] := $20 ;                                       }
  376.       $B0/$20/                               { MOV AL,20h        }
  377.       $E6/$20                                { OUT 20h,AL        }
  378.       )
  379.     END { Async_ISR } ;
  380.  
  381.  
  382.   procedure Async_Init;
  383.   { initialize variables }
  384.   begin
  385.     Async_Open_Flag := FALSE;
  386.     Async_Buffer_Overflow := FALSE;
  387.     Async_Buffer_Used := 0;
  388.     Async_MaxBufferUsed := 0;
  389.   end; { Async_Init }
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400.  
  401.  
  402.  
  403.  
  404.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  405.   VERSION  :  4.0xx
  406.        OS  :  PC-DOS
  407.      DATE  :  January 28, 1988                        PAGE  :  7/14
  408.  
  409.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  410.  
  411.  
  412.  
  413.  
  414.   procedure Async_Close;
  415.   { reset the interrupt system when UART interrupts              }
  416.   { no longer needed                                             }
  417.   var
  418.     i, m : Word;
  419.   begin
  420.     if Async_Open_Flag then
  421.       begin
  422.  
  423.         { disable the IRQ on the 8259 }
  424.         Inline($FA);                         { disable interrupts }
  425.         i := Port[I8088_IMR];   { get the interrupt mask register }
  426.         m := 1 shl Async_Irq;    { set mask to turn off interrupt }
  427.         Port[I8088_IMR] := i or m;
  428.  
  429.         { disable the 8250 data ready interrupt }
  430.         Port[UART_IER + Async_Base] := 0;
  431.  
  432.         { disable OUT2 on the 8250 }
  433.         Port[UART_MCR + Async_Base] := 0;
  434.         Inline($FB);                         { enable interrupts  }
  435.  
  436.         { re-initialize our data areas so we know the port is     }
  437.         { closed                                                  }
  438.         Async_Open_Flag := FALSE;
  439.  
  440.         { Version 4 support by Keith Hawes next 2 lines           }
  441.         SetIntVec( Async_IRQ + 8, @Async_Interrupt_Save );
  442.                                           { Restore old interrupt }
  443.         ExitProc := Async_ExitProc_Save; { Restore ExitProc chain}
  444.       end
  445.   end; { Async_Close }
  446.  
  447.   function Async_Open(ComPort       : Word;
  448.                       BaudRate      : Word;
  449.                       Parity        : Char;
  450.                       WordSize      : Word;
  451.                       StopBits      : Word) : Boolean;
  452.   { open a communications port }
  453.   var
  454.     ComParm : Word;
  455.     i, m : Word;
  456.   begin
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463.  
  464.  
  465.  
  466.  
  467.  
  468.  
  469.  
  470.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  471.   VERSION  :  4.0xx
  472.        OS  :  PC-DOS
  473.      DATE  :  January 28, 1988                        PAGE  :  8/14
  474.  
  475.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  476.  
  477.  
  478.  
  479.  
  480.     if Async_Open_Flag then Async_Close;
  481.  
  482.     if (ComPort = 2) and (Async_BIOS_Port_Table[2] <> 0) then
  483.       Async_Port := 2
  484.     else
  485.       Async_Port := 1;  { default to COM1 }
  486.     Async_Base := Async_BIOS_Port_Table[Async_Port];
  487.     Async_Irq := Hi(Async_Base) + 1;
  488.  
  489.     if (Port[UART_IIR + Async_Base] and $00F8) <> 0 then
  490.       Async_Open := FALSE
  491.     else
  492.       begin
  493.         Async_Buffer_Head := 0;
  494.         Async_Buffer_Tail := 0;
  495.         Async_Buffer_Overflow := FALSE;
  496.  
  497.     { Build the ComParm for RS232_Init }
  498.     { See Technical Reference Manual for description }
  499.  
  500.         ComParm := $0000;
  501.  
  502.     { Set up the bits for the baud rate }
  503.         i := 0;
  504.         repeat
  505.           i := i + 1
  506.         until (Async_Baud_Table[i].Baud = BaudRate)
  507.                 or (i = Async_Num_Bauds);
  508.         ComParm := ComParm or Async_Baud_Table[i].Bits;
  509.  
  510.         if Parity in ['E', 'e'] then ComParm := ComParm or $0018
  511.         else if Parity in ['O', 'o'] then
  512.              ComParm := ComParm or $0008
  513.         else ComParm := ComParm or $0000;  { default to No parity }
  514.         if WordSize = 7 then ComParm := ComParm or $0002
  515.         else ComParm := ComParm or $0003;
  516.                                          { default to 8 data bits }
  517.  
  518.         if StopBits = 2 then ComParm := ComParm or $0004
  519.         else ComParm := ComParm or $0000;
  520.                                           { default to 1 stop bit }
  521.  
  522.         { use the BIOS COM port initialization routine            }
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  
  532.  
  533.  
  534.  
  535.  
  536.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  537.   VERSION  :  4.0xx
  538.        OS  :  PC-DOS
  539.      DATE  :  January 28, 1988                        PAGE  :  9/14
  540.  
  541.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  542.  
  543.  
  544.  
  545.  
  546.         { to save typing the code                                 }
  547.  
  548.         BIOS_RS232_Init(Async_Port - 1, ComParm);
  549.         GetIntVec( Async_Irq + 8, Async_Interrupt_Save );
  550.                                            { Version 4 support KH }
  551.         Async_ExitProc_Save := ExitProc; { Version 4 support KH }
  552.         ExitProc := @Async_Close;         { Version 4 support KH }
  553.         SetIntVec( Async_Irq + 8, @Async_Isr );
  554.                                            { Version 4 support KH }
  555.  
  556.   { Read the RBR and reset any possible pending error conditions. }
  557.   { First turn off the Divisor Access Latch Bit to allow access to}
  558.   { RBR, etc.                                                     }
  559.  
  560.         Inline($FA);                         { disable interrupts }
  561.  
  562.         Port[UART_LCR + Async_Base] :=
  563.                 Port[UART_LCR + Async_Base] and $7F;
  564.         { read the Line Status Register to reset any errors it    }
  565.         { indicates                                               }
  566.         i := Port[UART_LSR + Async_Base];
  567.         { read the Receiver Buffer Register in case it contains a }
  568.         { character                                               }
  569.         i := Port[UART_RBR + Async_Base];
  570.  
  571.         { enable the irq on the 8259 controller                   }
  572.         i := Port[I8088_IMR];   { get the interrupt mask register }
  573.         m := (1 shl Async_Irq) xor $00FF;
  574.         Port[I8088_IMR] := i and m;
  575.  
  576.         { enable the data ready interrupt on the 8250             }
  577.         Port[UART_IER + Async_Base] := $01;
  578.         { enable data ready interrupt                             }
  579.  
  580.         { enable OUT2 on 8250                                     }
  581.         i := Port[UART_MCR + Async_Base];
  582.         Port[UART_MCR + Async_Base] := i or $08;
  583.         Inline($FB);                         { enable interrupts  }
  584.         Async_Open_Flag := TRUE;          { bug fix by Scott Herr }
  585.         Async_Open := TRUE
  586.       end;
  587.   end; { Async_Open }
  588.  
  589.  
  590.  
  591.  
  592.  
  593.  
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  603.   VERSION  :  4.0xx
  604.        OS  :  PC-DOS
  605.      DATE  :  January 28, 1988                       PAGE  :  10/14
  606.  
  607.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  608.  
  609.  
  610.  
  611.  
  612.   function Async_Buffer_Check(var C : Char) : Boolean;
  613.         { see if a character has been received; return it if yes  }
  614.   begin
  615.     if Async_Buffer_Head = Async_Buffer_Tail then
  616.       Async_Buffer_Check := FALSE
  617.     else
  618.       begin
  619.         C := Async_Buffer[Async_Buffer_Tail];
  620.         Async_Buffer_Tail := Async_Buffer_Tail + 1;
  621.         if Async_Buffer_Tail > Async_Buffer_Max then
  622.           Async_Buffer_Tail := 0;
  623.         Async_Buffer_Used := Async_Buffer_Used - 1;
  624.         Async_Buffer_Check := TRUE
  625.       end
  626.   end; { Async_Buffer_Check }
  627.  
  628.   procedure Async_Send(C : Char);
  629.                                            { transmit a character }
  630.   var
  631.     i, m, counter : Word;
  632.   begin
  633.     Port[UART_MCR + Async_Base] := $0B;
  634.                                      { turn on OUT2, DTR, and RTS }
  635.  
  636.                                              { wait for CTS       }
  637.     counter := MaxInt;
  638.     while (counter <> 0) and
  639.           ((Port[UART_MSR + Async_Base] and $10) = 0) do
  640.       counter := counter - 1;
  641.  
  642.                    { wait for Transmit Hold Register Empty (THRE) }
  643.     if counter <> 0 then counter := MaxInt;
  644.     while (counter <> 0) and
  645.           ((Port[UART_LSR + Async_Base] and $20) = 0) do
  646.       counter := counter - 1;
  647.     if counter <> 0 then
  648.       begin
  649.                                              { send the character }
  650.         Inline($FA);                         { disable interrupts }
  651.         Port[UART_THR + Async_Base] := Ord(C);
  652.         Inline($FB)                          { enable interrupts  }
  653.       end
  654.     else
  655.  
  656.  
  657.  
  658.  
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  669.   VERSION  :  4.0xx
  670.        OS  :  PC-DOS
  671.      DATE  :  January 28, 1988                       PAGE  :  11/14
  672.  
  673.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  674.  
  675.  
  676.  
  677.  
  678.       writeln('<<<TIMEOUT>>>');
  679.   end; { Async_Send }
  680.  
  681.   procedure Async_Send_String(S : String);
  682.   { transmit a string }
  683.   var
  684.     i : Word;
  685.   begin
  686.     for i := 1 to length(S) do
  687.       Async_Send(S[i])
  688.   end; { Async_Send_String }
  689.  
  690.   procedure Async_Change(BaudRate      : Word;
  691.                          Parity        : Char;
  692.                          WordSize      : Word;
  693.                          StopBits      : Word);
  694.   { change communication parameters "on the fly"                 }
  695.   { you cannot use the BIOS routines because they drop DTR       }
  696.  
  697.   const num_bauds = 15;
  698.       divisor_table : array [1..num_bauds] of record
  699.                                               baud, divisor : Word
  700.                                             end
  701.          = ((baud:50;  divisor:2304),
  702.             (baud:75;  divisor:1536),
  703.             (baud:110; divisor:1047),
  704.             (baud:134; divisor:857),
  705.             (baud:150; divisor:768),
  706.             (baud:300; divisor:384),
  707.             (baud:600; divisor:192),
  708.             (baud:1200; divisor:96),
  709.             (baud:1800; divisor:64),
  710.             (baud:2000; divisor:58),
  711.             (baud:2400; divisor:48),
  712.             (baud:3600; divisor:32),
  713.             (baud:4800; divisor:24),
  714.             (baud:7200; divisor:16),
  715.             (baud:9600; divisor:12));
  716.  
  717.   var i : Word;
  718.       dv  : Word;
  719.       lcr : Word;
  720.   begin
  721.  
  722.  
  723.  
  724.  
  725.  
  726.  
  727.  
  728.  
  729.  
  730.  
  731.  
  732.  
  733.  
  734.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  735.   VERSION  :  4.0xx
  736.        OS  :  PC-DOS
  737.      DATE  :  January 28, 1988                       PAGE  :  12/14
  738.  
  739.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  740.  
  741.  
  742.  
  743.  
  744.     { Build the Line Control Register and find                   }
  745.     { the divisor (for the baud rate)                            }
  746.  
  747.     { Set up the divisor for the baud rate                       }
  748.     i := 0;
  749.     repeat
  750.       i := i + 1
  751.     until (Divisor_Table[i].Baud = BaudRate) or (i = Num_Bauds);
  752.     dv  := Divisor_Table[i].divisor;
  753.  
  754.     lcr := 0;
  755.     case Parity of
  756.       'E' : lcr := lcr or $18;  { even parity }
  757.       'O' : lcr := lcr or $08;  { odd parity }
  758.       'N' : lcr := lcr or $00;  { no parity }
  759.       'M' : lcr := lcr or $28;  { Mark parity }
  760.       'S' : lcr := lcr or $38;  { Space parity }
  761.     else
  762.       lcr := lcr or $00;  { default to no parity }
  763.     end;
  764.  
  765.     case WordSize of
  766.       5 : lcr := lcr or $00;
  767.       6 : lcr := lcr or $01;
  768.       7 : lcr := lcr or $02;
  769.       8 : lcr := lcr or $03;
  770.     else
  771.       lcr := lcr or $03;  { default to 8 data bits }
  772.     end;
  773.  
  774.     if StopBits = 2 then lcr := lcr or $04
  775.     else lcr := lcr or $00;  { default to 1 stop bit }
  776.  
  777.     lcr := lcr and $7F;   { make certain the DLAB is off }
  778.  
  779.     Inline($FA);  { disable interrupts }
  780.  
  781.     { turn on DLAB to access the divisor                         }
  782.     Port[UART_LCR + Async_Base] := Port[UART_LCR +
  783.                                        Async_Base] or $80;
  784.  
  785.     { set the divisor                                            }
  786.     Port[Async_Base] := Lo(dv);
  787.  
  788.  
  789.  
  790.  
  791.  
  792.  
  793.  
  794.  
  795.  
  796.  
  797.  
  798.  
  799.  
  800.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  801.   VERSION  :  4.0xx
  802.        OS  :  PC-DOS
  803.      DATE  :  January 28, 1988                       PAGE  :  13/14
  804.  
  805.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  806.  
  807.  
  808.  
  809.  
  810.     Port[Async_Base + 1] := Hi(dv);
  811.  
  812.     { turn off the DLAB and set the new comm. parameters         }
  813.     Port[UART_LCR + Async_Base] := lcr;
  814.  
  815.     Inline($FB);  { enable interrupts }
  816.  
  817.   end; { Async_Change }
  818.   end.
  819.  
  820.   *****************************************************************
  821.     Test Program.... place in a separate file and compile with the
  822.   Make option.
  823.  
  824.   program tty;
  825.   uses crt,async;
  826.   var
  827.     c : char;
  828.  
  829.   begin
  830.     Async_Init;  { initialize variables }
  831.     if not Async_Open(2, 1200, 'E', 7, 1) then
  832.                                        { open communications port }
  833.       begin
  834.         writeln('**ERROR: Async_Open failed');
  835.         halt
  836.       end;
  837.  
  838.     writeln('TTY Emulation begins now...');
  839.     writeln('Press ESC key to terminate...');
  840.  
  841.     repeat
  842.       if Async_Buffer_Check(c) then
  843.         case c of
  844.           #000 : ;  { strip incoming nulls }
  845.           #010 : ;  { strip incoming line feeds }
  846.           #012 : ClrScr;  { clear screen on a form feed }
  847.           #013 : Writeln  { handle carriage return as CR/LF }
  848.         else
  849.           write(c)  { else write incoming char to the screen }
  850.         end; { case }
  851.       if KeyPressed then
  852.         begin
  853.  
  854.  
  855.  
  856.  
  857.  
  858.  
  859.  
  860.  
  861.  
  862.  
  863.  
  864.  
  865.  
  866.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  407
  867.   VERSION  :  4.0xx
  868.        OS  :  PC-DOS
  869.      DATE  :  January 28, 1988                       PAGE  :  14/14
  870.  
  871.     TITLE  :  ASYNCHRONOUS COMMUNICATIONS
  872.  
  873.  
  874.  
  875.  
  876.           c := readkey;
  877.           if c = #027 then  { Trap Esc Key }
  878.             begin
  879.               Async_Close;   { reset the interrupt system, etc. }
  880.               Writeln('End of TTY Emulation...');
  881.               halt;          { terminate the program }
  882.             end
  883.           else
  884.             Async_Send(c)
  885.         end;
  886.     until FALSE;
  887.   end.
  888.  
  889.   ****************************************************************
  890.  
  891.   DISCLAIMER: You have the right to use this technical information
  892.   subject to the terms of the No-Nonsense License Statement that
  893.   you received with the Borland product to which this information
  894.   pertains.
  895.  
  896.  
  897.  
  898.  
  899.  
  900.  
  901.  
  902.  
  903.  
  904.  
  905.  
  906.  
  907.  
  908.  
  909.  
  910.  
  911.  
  912.  
  913.  
  914.  
  915.  
  916.  
  917.  
  918.  
  919.  
  920.  
  921.  
  922.  
  923.  
  924.  
  925.